home *** CD-ROM | disk | FTP | other *** search
/ Amiga Format CD 52 / Amiga Format AFCD52 (Issue 136, May 2000).iso / -screenplay- / shareware / solitarexx / scripts / spider.srx < prev    next >
Text File  |  2000-02-29  |  3KB  |  162 lines
  1. /******************************\
  2. ** Spider v1.0 for Solitarexx **
  3. **   by Michal Szafranski     **
  4. \******************************/
  5. OPTIONS RESULTS
  6.  
  7. tex = 'Spider'
  8. wintex = '"We Have a Winner"'
  9. ADDBUTTON 0 10 "Start"
  10. ADDCYCLE 1 6 '0|1|2|3|4|5|6' 2 'Reshuffles' 12
  11. ADDTEXT 4 24 tex 6
  12. ADDBUTTON 12 10 "Abort"
  13. ADDBUTTON 13 15 "Reshuffle"
  14. ADDTEXT 14 27 tex 6
  15. SELECTGUI 1
  16.  
  17. SCREENSIZE 4 14 6 0
  18. NEWSTACK 3 8+2 0 0 1 0 7 9
  19. stack.0 = RESULT
  20. NEWSTACK 3 8+0 0 0 2 0 7 9
  21. stack.11 = RESULT
  22. bst. = 0
  23. DO i = 0 TO 3
  24.     k = i+1
  25.     j = -i+10
  26.     b = i+4
  27.     NEWSTACK 3 8+2 0 i+1 0 0 7 7
  28.     stack.k = RESULT
  29.     NEWSTACK 3 8   0 i+1 3 0 7 7
  30.     stack.j = RESULT
  31.     NEWSTACK 1 8   0 i+1 1 0 7
  32.     base.i = RESULT
  33.     NEWSTACK 1 8   0 i+1 2 0 7
  34.     base.b = RESULT
  35.     bst.k = base.i
  36.     bst.j = base.b
  37. END
  38. NEWSTACK 3 8+2 0 5 1 0 7 9
  39. stack.5 = RESULT
  40. NEWSTACK 3 8+0 0 5 2 0 7 9
  41. stack.6 = RESULT
  42. NEWSTACK 0 128
  43. deck = RESULT
  44. ADDCARDS deck
  45. ADDCARDS deck SHUFFLED
  46.  
  47. DO FOREVER
  48.     ACTION
  49.     PARSE VAR RESULT act rest
  50.     IF act = 1 THEN EXIT
  51.     IF act = 3 THEN CALL GAME
  52. END
  53.  
  54. GAME:
  55.     CLEANUP deck
  56.     SETGADGET 14 STR tex
  57.     SELECTGUI 4
  58.     kbase. = -2
  59.     DO i=0 TO 3
  60.         kbase.12.i = -1
  61.         kbase.0.i = -1
  62.     END
  63.     b = 0
  64.     s = 0
  65.     fin = 0
  66.     seq.= 0
  67.     DO FOR 104
  68.         CARDSELECT deck 1
  69.         PARSE VAR RESULT k war .
  70.         IF kbase.war.k = -1 THEN DO
  71.             base = base.b
  72.             MOVECARDS deck base REVERSE
  73.             kbase.war.k = base
  74.             seq.base = 1-2*(war>0)
  75.             b = b+1
  76.         END
  77.         ELSE CALL DOCYCLE
  78.     END
  79.     sel = 0
  80.     GETGADGET 1
  81.     res = RESULT
  82.     DO FOREVER
  83.         ACTION
  84.         PARSE VAR RESULT act stack sid card
  85.         SELECT
  86.         WHEN act = 1 THEN EXIT
  87.         WHEN act = 2 & sel = 0 & card>0 & sid=3 THEN sel = stack
  88.         WHEN act = 2 & sel > 0 & (sid = 1 | sel = stack) THEN CALL DOBASE
  89.         WHEN act = 2 & sel > 0 & sid = 3 THEN CALL DOSTACKS
  90.         WHEN act = 3 & stack = 13 & res>0 THEN CALL DORES
  91.         WHEN act = 3 & stack = 12 THEN DO
  92.             SELECTGUI 1
  93.             RETURN
  94.         END
  95.         OTHERWISE ERRBEEP
  96.         END
  97.     END
  98. RETURN
  99. DOSTACKS:
  100.     CARDSELECT sel 0 RELATIVE
  101.     PARSE VAR RESULT k1 w1 .
  102.     CARDSELECT stack 1
  103.     PARSE VAR RESULT k2 w2 .
  104.     IF k2 = '' THEN DO
  105.         w = (w1=0|w1=12)
  106.         k2 = k1
  107.     END
  108.     ELSE w = ABS(w1-w2)
  109.     IF w=1 & k1 = k2 THEN MOVECARDS sel stack
  110.     ELSE ERRBEEP
  111.     sel = 0
  112. RETURN
  113. DORES:
  114.     res = res-1
  115.     DO i = 0 TO 11
  116.         CARDSELECT stack.i 33
  117.         MOVECARDS stack.i deck REVERSE
  118.     END
  119.     s = 0
  120.     DO FOR 96-fin
  121.         CARDSELECT deck 1
  122.         PARSE VAR RESULT k war .
  123.         CALL DOCYCLE
  124.     END
  125.     sel = 0
  126. RETURN
  127. DOCYCLE:
  128.     MOVECARDS deck stack.s REVERSE
  129.     stack = bst.s
  130.     IF stack > 0 & seq.stack~=0 THEN DO
  131.         sel = stack.s
  132.         CALL CHBASE
  133.         IF ok=0 THEN DO
  134.             fin = fin +1
  135.             MOVECARDS sel stack
  136.         END
  137.     END
  138.     s = (s+1)//12
  139. RETURN
  140. DOBASE:
  141.     IF sel~=stack THEN CALL CHBASE
  142.     ELSE DO i= 0 TO 7 UNTIL ok=0
  143.         stack = base.i
  144.         CALL CHBASE
  145.     END
  146.     IF ok=0 THEN DO
  147.         fin = fin +1
  148.         MOVECARDS sel stack
  149.         IF fin = 96 THEN SETGADGET 14 STR wintex
  150.     END
  151.     ELSE ERRBEEP
  152.     sel = 0
  153. RETURN
  154. CHBASE:
  155.     CARDSELECT sel 1
  156.     PARSE VAR RESULT k1 w1 .
  157.     CARDSELECT stack 1
  158.     PARSE VAR RESULT k2 w2 .
  159.     IF k1 = k2 & (w1 - w2) = seq.stack THEN ok = 0
  160.     ELSE ok = 1
  161. RETURN
  162.